home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Tcl-Tk 8.0 / Pre-installed version / tcl8.0 / win / tclWinSock.c < prev    next >
Encoding:
C/C++ Source or Header  |  1997-08-15  |  59.2 KB  |  2,100 lines  |  [TEXT/CWIE]
  1. /* 
  2.  * tclWinSock.c --
  3.  *
  4.  *    This file contains Windows-specific socket related code.
  5.  *
  6.  * Copyright (c) 1995-1997 Sun Microsystems, Inc.
  7.  *
  8.  * See the file "license.terms" for information on usage and redistribution
  9.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  10.  *
  11.  * SCCS: @(#) tclWinSock.c 1.79 97/06/20 14:15:47
  12.  */
  13.  
  14. #include "tclInt.h"
  15. #include "tclPort.h"
  16.  
  17. /*
  18.  * The following variable is used to tell whether this module has been
  19.  * initialized.
  20.  */
  21.  
  22. static int initialized = 0;
  23.  
  24. static int  hostnameInitialized = 0;
  25. static char hostname[255];    /* This buffer should be big enough for
  26.                                  * hostname plus domain name. */
  27.  
  28. /*
  29.  * The following structure contains pointers to all of the WinSock API entry
  30.  * points used by Tcl.  It is initialized by InitSockets.  Since we
  31.  * dynamically load Winsock.dll on demand, we must use this function table
  32.  * to refer to functions in the socket API.
  33.  */
  34.  
  35. static struct {
  36.     HINSTANCE hInstance;    /* Handle to WinSock library. */
  37.     HWND hwnd;            /* Handle to window for socket messages. */
  38.     SOCKET (PASCAL FAR *accept)(SOCKET s, struct sockaddr FAR *addr,
  39.         int FAR *addrlen);
  40.     int (PASCAL FAR *bind)(SOCKET s, const struct sockaddr FAR *addr,
  41.         int namelen);
  42.     int (PASCAL FAR *closesocket)(SOCKET s);
  43.     int (PASCAL FAR *connect)(SOCKET s, const struct sockaddr FAR *name,
  44.         int namelen);
  45.     int (PASCAL FAR *ioctlsocket)(SOCKET s, long cmd, u_long FAR *argp);
  46.     int (PASCAL FAR *getsockopt)(SOCKET s, int level, int optname,
  47.         char FAR * optval, int FAR *optlen);
  48.     u_short (PASCAL FAR *htons)(u_short hostshort);
  49.     unsigned long (PASCAL FAR *inet_addr)(const char FAR * cp);
  50.     char FAR * (PASCAL FAR *inet_ntoa)(struct in_addr in);
  51.     int (PASCAL FAR *listen)(SOCKET s, int backlog);
  52.     u_short (PASCAL FAR *ntohs)(u_short netshort);
  53.     int (PASCAL FAR *recv)(SOCKET s, char FAR * buf, int len, int flags);
  54.     int (PASCAL FAR *send)(SOCKET s, const char FAR * buf, int len, int flags);
  55.     int (PASCAL FAR *setsockopt)(SOCKET s, int level, int optname,
  56.         const char FAR * optval, int optlen);
  57.     int (PASCAL FAR *shutdown)(SOCKET s, int how);
  58.     SOCKET (PASCAL FAR *socket)(int af, int type, int protocol);
  59.     struct hostent FAR * (PASCAL FAR *gethostbyname)(const char FAR * name);
  60.     struct hostent FAR * (PASCAL FAR *gethostbyaddr)(const char FAR *addr,
  61.             int addrlen, int addrtype);
  62.     int (PASCAL FAR *gethostname)(char FAR * name, int namelen);
  63.     int (PASCAL FAR *getpeername)(SOCKET sock, struct sockaddr FAR *name,
  64.             int FAR *namelen);
  65.     struct servent FAR * (PASCAL FAR *getservbyname)(const char FAR * name,
  66.         const char FAR * proto);
  67.     int (PASCAL FAR *getsockname)(SOCKET sock, struct sockaddr FAR *name,
  68.             int FAR *namelen);
  69.     int (PASCAL FAR *WSAStartup)(WORD wVersionRequired, LPWSADATA lpWSAData);
  70.     int (PASCAL FAR *WSACleanup)(void);
  71.     int (PASCAL FAR *WSAGetLastError)(void);
  72.     int (PASCAL FAR *WSAAsyncSelect)(SOCKET s, HWND hWnd, u_int wMsg,
  73.         long lEvent);
  74. } winSock;
  75.  
  76. /*
  77.  * The following defines declare the messages used on socket windows.
  78.  */
  79.  
  80. #define SOCKET_MESSAGE    WM_USER+1
  81.  
  82. /*
  83.  * The following structure is used to store the data associated with
  84.  * each socket.
  85.  */
  86.  
  87. typedef struct SocketInfo {
  88.     Tcl_Channel channel;       /* Channel associated with this socket. */
  89.     SOCKET socket;           /* Windows SOCKET handle. */
  90.     int flags;               /* Bit field comprised of the flags
  91.                     * described below.  */
  92.     int watchEvents;           /* OR'ed combination of FD_READ, FD_WRITE,
  93.                                     * FD_CLOSE, FD_ACCEPT and FD_CONNECT that
  94.                     * indicate which events are interesting. */
  95.     int readyEvents;           /* OR'ed combination of FD_READ, FD_WRITE,
  96.                                     * FD_CLOSE, FD_ACCEPT and FD_CONNECT that
  97.                     * indicate which events have occurred. */
  98.     int selectEvents;           /* OR'ed combination of FD_READ, FD_WRITE,
  99.                                     * FD_CLOSE, FD_ACCEPT and FD_CONNECT that
  100.                     * indicate which events are currently
  101.                     * being selected. */
  102.     Tcl_TcpAcceptProc *acceptProc; /* Proc to call on accept. */
  103.     ClientData acceptProcData;       /* The data for the accept proc. */
  104.     int lastError;           /* Error code from last message. */
  105.     struct SocketInfo *nextPtr;       /* The next socket on the global socket
  106.                     * list. */
  107. } SocketInfo;
  108.  
  109. /*
  110.  * The following structure is what is added to the Tcl event queue when
  111.  * a socket event occurs.
  112.  */
  113.  
  114. typedef struct SocketEvent {
  115.     Tcl_Event header;        /* Information that is standard for
  116.                  * all events. */
  117.     SOCKET socket;        /* Socket descriptor that is ready.  Used
  118.                  * to find the SocketInfo structure for
  119.                  * the file (can't point directly to the
  120.                  * SocketInfo structure because it could
  121.                  * go away while the event is queued). */
  122. } SocketEvent;
  123.  
  124. /*
  125.  * This defines the minimum buffersize maintained by the kernel.
  126.  */
  127.  
  128. #define TCP_BUFFER_SIZE 4096
  129.  
  130. /*
  131.  * The following macros may be used to set the flags field of
  132.  * a SocketInfo structure.
  133.  */
  134.  
  135. #define SOCKET_ASYNC        (1<<0)    /* The socket is in blocking mode. */
  136. #define SOCKET_EOF        (1<<1)    /* A zero read happened on
  137.                      * the socket. */
  138. #define SOCKET_ASYNC_CONNECT    (1<<2)    /* This socket uses async connect. */
  139. #define SOCKET_PENDING        (1<<3)    /* A message has been sent
  140.                      * for this socket */
  141.  
  142. /*
  143.  * Every open socket has an entry on the following list.
  144.  */
  145.  
  146. static SocketInfo *socketList;
  147.  
  148. /*
  149.  * Static functions defined in this file.
  150.  */
  151.  
  152. static SocketInfo *    CreateSocket _ANSI_ARGS_((Tcl_Interp *interp,
  153.                 int port, char *host, int server, char *myaddr,
  154.                 int myport, int async));
  155. static int        CreateSocketAddress _ANSI_ARGS_(
  156.                 (struct sockaddr_in *sockaddrPtr,
  157.                 char *host, int port));
  158. static void        InitSockets _ANSI_ARGS_((void));
  159. static SocketInfo *    NewSocketInfo _ANSI_ARGS_((SOCKET socket));
  160. static void        SocketCheckProc _ANSI_ARGS_((ClientData clientData,
  161.                 int flags));
  162. static int        SocketEventProc _ANSI_ARGS_((Tcl_Event *evPtr,
  163.                 int flags));
  164. static void        SocketExitHandler _ANSI_ARGS_((ClientData clientData));
  165. static LRESULT CALLBACK    SocketProc _ANSI_ARGS_((HWND hwnd, UINT message,
  166.                 WPARAM wParam, LPARAM lParam));
  167. static void        SocketSetupProc _ANSI_ARGS_((ClientData clientData,
  168.                 int flags));
  169. static void        TcpAccept _ANSI_ARGS_((SocketInfo *infoPtr));
  170. static int        TcpBlockProc _ANSI_ARGS_((ClientData instanceData,
  171.                 int mode));
  172. static int        TcpCloseProc _ANSI_ARGS_((ClientData instanceData,
  173.                         Tcl_Interp *interp));
  174. static int        TcpGetOptionProc _ANSI_ARGS_((ClientData instanceData,
  175.                     Tcl_Interp *interp, char *optionName,
  176.                 Tcl_DString *optionValue));
  177. static int        TcpInputProc _ANSI_ARGS_((ClientData instanceData,
  178.                         char *buf, int toRead, int *errorCode));
  179. static int        TcpOutputProc _ANSI_ARGS_((ClientData instanceData,
  180.                         char *buf, int toWrite, int *errorCode));
  181. static void        TcpWatchProc _ANSI_ARGS_((ClientData instanceData,
  182.                     int mask));
  183. static int        TcpGetHandleProc _ANSI_ARGS_((ClientData instanceData,
  184.                     int direction, ClientData *handlePtr));
  185. static int        WaitForSocketEvent _ANSI_ARGS_((SocketInfo *infoPtr,
  186.                     int events, int *errorCodePtr));
  187.  
  188. /*
  189.  * This structure describes the channel type structure for TCP socket
  190.  * based IO.
  191.  */
  192.  
  193. static Tcl_ChannelType tcpChannelType = {
  194.     "tcp",        /* Type name. */
  195.     TcpBlockProc,    /* Set socket into blocking/non-blocking mode. */
  196.     TcpCloseProc,    /* Close proc. */
  197.     TcpInputProc,    /* Input proc. */
  198.     TcpOutputProc,    /* Output proc. */
  199.     NULL,        /* Seek proc. */
  200.     NULL,        /* Set option proc. */
  201.     TcpGetOptionProc,    /* Get option proc. */
  202.     TcpWatchProc,    /* Initialize notifier to watch this channel. */
  203.     TcpGetHandleProc,    /* Get an OS handle from channel. */
  204. };
  205.  
  206. /*
  207.  * Define version of Winsock required by Tcl.
  208.  */
  209.  
  210. #define WSA_VERSION_REQD MAKEWORD(1,1)
  211.  
  212. /*
  213.  *----------------------------------------------------------------------
  214.  *
  215.  * InitSockets --
  216.  *
  217.  *    Initialize the socket module.  Attempts to load the wsock32.dll
  218.  *    library and set up the winSock function table.  If successful,
  219.  *    registers the event window for the socket notifier code.
  220.  *
  221.  * Results:
  222.  *    None.
  223.  *
  224.  * Side effects:
  225.  *    Dynamically loads wsock32.dll, and registers a new window
  226.  *    class and creates a window for use in asynchronous socket
  227.  *    notification.
  228.  *
  229.  *----------------------------------------------------------------------
  230.  */
  231.  
  232. static void
  233. InitSockets()
  234. {
  235.     WSADATA wsaData;
  236.     OSVERSIONINFO info;
  237.     WNDCLASS class;
  238.  
  239.     initialized = 1;
  240.     Tcl_CreateExitHandler(SocketExitHandler, (ClientData) NULL);
  241.  
  242.     /*
  243.      * Find out if we're running on Win32s.
  244.      */
  245.  
  246.     info.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
  247.     GetVersionEx(&info);
  248.  
  249.     /*
  250.      * Check to see if Sockets are supported on this system.  Since
  251.      * win32s panics if we call WSAStartup on a system that doesn't
  252.      * have winsock.dll, we need to look for it on the system first.
  253.      * If we find winsock, then load the library and initialize the
  254.      * stub table.
  255.      */
  256.  
  257.     if ((info.dwPlatformId != VER_PLATFORM_WIN32s)
  258.         || (SearchPath(NULL, "WINSOCK", ".DLL", 0, NULL, NULL) != 0)) {
  259.     winSock.hInstance = LoadLibrary("wsock32.dll");
  260.     } else {
  261.     winSock.hInstance = NULL;
  262.     }
  263.  
  264.     /*
  265.      * Initialize the function table.
  266.      */
  267.  
  268.     if (winSock.hInstance == NULL) {
  269.     return;
  270.     }
  271.  
  272.     winSock.accept = (SOCKET (PASCAL FAR *)(SOCKET s,
  273.             struct sockaddr FAR *addr, int FAR *addrlen))
  274.         GetProcAddress(winSock.hInstance, "accept");
  275.     winSock.bind = (int (PASCAL FAR *)(SOCKET s,
  276.             const struct sockaddr FAR *addr, int namelen))
  277.         GetProcAddress(winSock.hInstance, "bind");
  278.     winSock.closesocket = (int (PASCAL FAR *)(SOCKET s))
  279.         GetProcAddress(winSock.hInstance, "closesocket");
  280.     winSock.connect = (int (PASCAL FAR *)(SOCKET s,
  281.             const struct sockaddr FAR *name, int namelen))
  282.         GetProcAddress(winSock.hInstance, "connect");
  283.     winSock.ioctlsocket = (int (PASCAL FAR *)(SOCKET s, long cmd,
  284.             u_long FAR *argp)) GetProcAddress(winSock.hInstance, "ioctlsocket");
  285.     winSock.getsockopt = (int (PASCAL FAR *)(SOCKET s,
  286.             int level, int optname, char FAR * optval, int FAR *optlen))
  287.         GetProcAddress(winSock.hInstance, "getsockopt");
  288.     winSock.htons = (u_short (PASCAL FAR *)(u_short hostshort))
  289.         GetProcAddress(winSock.hInstance, "htons");
  290.     winSock.inet_addr = (unsigned long (PASCAL FAR *)(const char FAR *cp))
  291.         GetProcAddress(winSock.hInstance, "inet_addr");
  292.     winSock.inet_ntoa = (char FAR * (PASCAL FAR *)(struct in_addr in))
  293.         GetProcAddress(winSock.hInstance, "inet_ntoa");
  294.     winSock.listen = (int (PASCAL FAR *)(SOCKET s, int backlog))
  295.         GetProcAddress(winSock.hInstance, "listen");
  296.     winSock.ntohs = (u_short (PASCAL FAR *)(u_short netshort))
  297.         GetProcAddress(winSock.hInstance, "ntohs");
  298.     winSock.recv = (int (PASCAL FAR *)(SOCKET s, char FAR * buf,
  299.             int len, int flags)) GetProcAddress(winSock.hInstance, "recv");
  300.     winSock.send = (int (PASCAL FAR *)(SOCKET s, const char FAR * buf,
  301.             int len, int flags)) GetProcAddress(winSock.hInstance, "send");
  302.     winSock.setsockopt = (int (PASCAL FAR *)(SOCKET s, int level,
  303.             int optname, const char FAR * optval, int optlen))
  304.         GetProcAddress(winSock.hInstance, "setsockopt");
  305.     winSock.shutdown = (int (PASCAL FAR *)(SOCKET s, int how))
  306.         GetProcAddress(winSock.hInstance, "shutdown");
  307.     winSock.socket = (SOCKET (PASCAL FAR *)(int af, int type,
  308.             int protocol)) GetProcAddress(winSock.hInstance, "socket");
  309.     winSock.gethostbyaddr = (struct hostent FAR * (PASCAL FAR *)
  310.             (const char FAR *addr, int addrlen, int addrtype))
  311.         GetProcAddress(winSock.hInstance, "gethostbyaddr");
  312.     winSock.gethostbyname = (struct hostent FAR * (PASCAL FAR *)
  313.             (const char FAR *name))
  314.         GetProcAddress(winSock.hInstance, "gethostbyname");
  315.     winSock.gethostname = (int (PASCAL FAR *)(char FAR * name,
  316.             int namelen)) GetProcAddress(winSock.hInstance, "gethostname");
  317.     winSock.getpeername = (int (PASCAL FAR *)(SOCKET sock,
  318.             struct sockaddr FAR *name, int FAR *namelen))
  319.         GetProcAddress(winSock.hInstance, "getpeername");
  320.     winSock.getservbyname = (struct servent FAR * (PASCAL FAR *)
  321.             (const char FAR * name, const char FAR * proto))
  322.         GetProcAddress(winSock.hInstance, "getservbyname");
  323.     winSock.getsockname = (int (PASCAL FAR *)(SOCKET sock,
  324.             struct sockaddr FAR *name, int FAR *namelen))
  325.         GetProcAddress(winSock.hInstance, "getsockname");
  326.     winSock.WSAStartup = (int (PASCAL FAR *)(WORD wVersionRequired,
  327.             LPWSADATA lpWSAData)) GetProcAddress(winSock.hInstance, "WSAStartup");
  328.     winSock.WSACleanup = (int (PASCAL FAR *)(void))
  329.         GetProcAddress(winSock.hInstance, "WSACleanup");
  330.     winSock.WSAGetLastError = (int (PASCAL FAR *)(void))
  331.         GetProcAddress(winSock.hInstance, "WSAGetLastError");
  332.     winSock.WSAAsyncSelect = (int (PASCAL FAR *)(SOCKET s, HWND hWnd,
  333.             u_int wMsg, long lEvent))
  334.         GetProcAddress(winSock.hInstance, "WSAAsyncSelect");
  335.  
  336.     /*
  337.      * Now check that all fields are properly initialized. If not, return
  338.      * zero to indicate that we failed to initialize properly.
  339.      */
  340.  
  341.     if ((winSock.hInstance == NULL) ||
  342.             (winSock.accept == NULL) ||
  343.             (winSock.bind == NULL) ||
  344.             (winSock.closesocket == NULL) ||
  345.             (winSock.connect == NULL) ||
  346.             (winSock.ioctlsocket == NULL) ||
  347.             (winSock.getsockopt == NULL) ||
  348.             (winSock.htons == NULL) ||
  349.             (winSock.inet_addr == NULL) ||
  350.             (winSock.inet_ntoa == NULL) ||
  351.             (winSock.listen == NULL) ||
  352.             (winSock.ntohs == NULL) ||
  353.             (winSock.recv == NULL) ||
  354.             (winSock.send == NULL) ||
  355.             (winSock.setsockopt == NULL) ||
  356.             (winSock.socket == NULL) ||
  357.             (winSock.gethostbyname == NULL) ||
  358.             (winSock.gethostbyaddr == NULL) ||
  359.             (winSock.gethostname == NULL) ||
  360.             (winSock.getpeername == NULL) ||
  361.             (winSock.getservbyname == NULL) ||
  362.             (winSock.getsockname == NULL) ||
  363.             (winSock.WSAStartup == NULL) ||
  364.             (winSock.WSACleanup == NULL) ||
  365.             (winSock.WSAGetLastError == NULL) ||
  366.             (winSock.WSAAsyncSelect == NULL)) {
  367.     goto unloadLibrary;
  368.     }
  369.     
  370.     /*
  371.      * Initialize the winsock library and check the version number.
  372.      */
  373.  
  374.     if ((*winSock.WSAStartup)(WSA_VERSION_REQD, &wsaData) != 0) {
  375.     goto unloadLibrary;
  376.     }
  377.     if (wsaData.wVersion != WSA_VERSION_REQD) {
  378.     (*winSock.WSACleanup)();
  379.     goto unloadLibrary;
  380.     }
  381.  
  382.     /*
  383.      * Create the async notification window with a new class.  We
  384.      * must create a new class to avoid a Windows 95 bug that causes
  385.      * us to get the wrong message number for socket events if the
  386.      * message window is a subclass of a static control.
  387.      */
  388.  
  389.     class.style = 0;
  390.     class.cbClsExtra = 0;
  391.     class.cbWndExtra = 0;
  392.     class.hInstance = TclWinGetTclInstance();
  393.     class.hbrBackground = NULL;
  394.     class.lpszMenuName = NULL;
  395.     class.lpszClassName = "TclSocket";
  396.     class.lpfnWndProc = SocketProc;
  397.     class.hIcon = NULL;
  398.     class.hCursor = NULL;
  399.  
  400.     if (RegisterClass(&class)) {
  401.     winSock.hwnd = CreateWindow("TclSocket", "TclSocket", WS_TILED, 0, 0,
  402.         0, 0, NULL, NULL, class.hInstance, NULL);
  403.     } else {
  404.     winSock.hwnd = NULL;
  405.     }
  406.     if (winSock.hwnd == NULL) {
  407.     TclWinConvertError(GetLastError());
  408.     (*winSock.WSACleanup)();
  409.     goto unloadLibrary;
  410.     }
  411.     Tcl_CreateEventSource(SocketSetupProc, SocketCheckProc, NULL);
  412.     return;
  413.  
  414. unloadLibrary:
  415.     FreeLibrary(winSock.hInstance);
  416.     winSock.hInstance = NULL;
  417.     return;
  418. }
  419.  
  420. /*
  421.  *----------------------------------------------------------------------
  422.  *
  423.  * SocketExitHandler --
  424.  *
  425.  *    Callback invoked during exit clean up to delete the socket
  426.  *    communication window and to release the WinSock DLL.
  427.  *
  428.  * Results:
  429.  *    None.
  430.  *
  431.  * Side effects:
  432.  *    None.
  433.  *
  434.  *----------------------------------------------------------------------
  435.  */
  436.  
  437.     /* ARGSUSED */
  438. static void
  439. SocketExitHandler(clientData)
  440.     ClientData clientData;              /* Not used. */
  441. {
  442.     if (winSock.hInstance) {
  443.     DestroyWindow(winSock.hwnd);
  444.     UnregisterClass("TclSocket", TclWinGetTclInstance());
  445.     (*winSock.WSACleanup)();
  446.     FreeLibrary(winSock.hInstance);
  447.     winSock.hInstance = NULL;
  448.     }
  449.     Tcl_DeleteEventSource(SocketSetupProc, SocketCheckProc, NULL);
  450.     initialized = 0;
  451.     hostnameInitialized = 0;
  452. }
  453.  
  454. /*
  455.  *----------------------------------------------------------------------
  456.  *
  457.  * TclHasSockets --
  458.  *
  459.  *    This function determines whether sockets are available on the
  460.  *    current system and returns an error in interp if they are not.
  461.  *    Note that interp may be NULL.
  462.  *
  463.  * Results:
  464.  *    Returns TCL_OK if the system supports sockets, or TCL_ERROR with
  465.  *    an error in interp.
  466.  *
  467.  * Side effects:
  468.  *    None.
  469.  *
  470.  *----------------------------------------------------------------------
  471.  */
  472.  
  473. int
  474. TclHasSockets(interp)
  475.     Tcl_Interp *interp;
  476. {
  477.     if (!initialized) {
  478.     InitSockets();
  479.     }
  480.     
  481.     if (winSock.hInstance != NULL) {
  482.     return TCL_OK;
  483.     }
  484.     if (interp != NULL) {
  485.     Tcl_AppendResult(interp, "sockets are not available on this system",
  486.         NULL);
  487.     }
  488.     return TCL_ERROR;
  489. }
  490.  
  491. /*
  492.  *----------------------------------------------------------------------
  493.  *
  494.  * SocketSetupProc --
  495.  *
  496.  *    This procedure is invoked before Tcl_DoOneEvent blocks waiting
  497.  *    for an event.
  498.  *
  499.  * Results:
  500.  *    None.
  501.  *
  502.  * Side effects:
  503.  *    Adjusts the block time if needed.
  504.  *
  505.  *----------------------------------------------------------------------
  506.  */
  507.  
  508. void
  509. SocketSetupProc(data, flags)
  510.     ClientData data;        /* Not used. */
  511.     int flags;            /* Event flags as passed to Tcl_DoOneEvent. */
  512. {
  513.     SocketInfo *infoPtr;
  514.     Tcl_Time blockTime = { 0, 0 };
  515.  
  516.     if (!(flags & TCL_FILE_EVENTS)) {
  517.     return;
  518.     }
  519.     
  520.     /*
  521.      * Check to see if there is a ready socket.  If so, poll.
  522.      */
  523.  
  524.     for (infoPtr = socketList; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
  525.     if (infoPtr->readyEvents & infoPtr->watchEvents) {
  526.         Tcl_SetMaxBlockTime(&blockTime);
  527.         break;
  528.     }
  529.     }
  530. }
  531.  
  532. /*
  533.  *----------------------------------------------------------------------
  534.  *
  535.  * SocketCheckProc --
  536.  *
  537.  *    This procedure is called by Tcl_DoOneEvent to check the socket
  538.  *    event source for events. 
  539.  *
  540.  * Results:
  541.  *    None.
  542.  *
  543.  * Side effects:
  544.  *    May queue an event.
  545.  *
  546.  *----------------------------------------------------------------------
  547.  */
  548.  
  549. static void
  550. SocketCheckProc(data, flags)
  551.     ClientData data;        /* Not used. */
  552.     int flags;            /* Event flags as passed to Tcl_DoOneEvent. */
  553. {
  554.     SocketInfo *infoPtr;
  555.     SocketEvent *evPtr;
  556.  
  557.     if (!(flags & TCL_FILE_EVENTS)) {
  558.     return;
  559.     }
  560.     
  561.     /*
  562.      * Queue events for any ready sockets that don't already have events
  563.      * queued (caused by persistent states that won't generate WinSock
  564.      * events).
  565.      */
  566.  
  567.     for (infoPtr = socketList; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
  568.     if ((infoPtr->readyEvents & infoPtr->watchEvents)
  569.         && !(infoPtr->flags & SOCKET_PENDING)) {
  570.         infoPtr->flags |= SOCKET_PENDING;
  571.         evPtr = (SocketEvent *) ckalloc(sizeof(SocketEvent));
  572.         evPtr->header.proc = SocketEventProc;
  573.         evPtr->socket = infoPtr->socket;
  574.         Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
  575.     }
  576.     }
  577. }
  578.  
  579. /*
  580.  *----------------------------------------------------------------------
  581.  *
  582.  * SocketEventProc --
  583.  *
  584.  *    This procedure is called by Tcl_ServiceEvent when a socket event
  585.  *    reaches the front of the event queue.  This procedure is
  586.  *    responsible for notifying the generic channel code.
  587.  *
  588.  * Results:
  589.  *    Returns 1 if the event was handled, meaning it should be removed
  590.  *    from the queue.  Returns 0 if the event was not handled, meaning
  591.  *    it should stay on the queue.  The only time the event isn't
  592.  *    handled is if the TCL_FILE_EVENTS flag bit isn't set.
  593.  *
  594.  * Side effects:
  595.  *    Whatever the channel callback procedures do.
  596.  *
  597.  *----------------------------------------------------------------------
  598.  */
  599.  
  600. static int
  601. SocketEventProc(evPtr, flags)
  602.     Tcl_Event *evPtr;        /* Event to service. */
  603.     int flags;            /* Flags that indicate what events to
  604.                  * handle, such as TCL_FILE_EVENTS. */
  605. {
  606.     SocketInfo *infoPtr;
  607.     SocketEvent *eventPtr = (SocketEvent *) evPtr;
  608.     int mask = 0;
  609.     u_long nBytes;
  610.     int status, events;
  611.  
  612.     if (!(flags & TCL_FILE_EVENTS)) {
  613.     return 0;
  614.     }
  615.  
  616.     /*
  617.      * Find the specified socket on the socket list.
  618.      */
  619.  
  620.     for (infoPtr = socketList; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
  621.     if (infoPtr->socket == eventPtr->socket) {
  622.         break;
  623.     }
  624.     }
  625.  
  626.     /*
  627.      * Discard events that have gone stale.
  628.      */
  629.  
  630.     if (!infoPtr) {
  631.     return 1;
  632.     }
  633.  
  634.     infoPtr->flags &= ~SOCKET_PENDING;
  635.  
  636.     /*
  637.      * Handle connection requests directly.
  638.      */
  639.  
  640.     if (infoPtr->readyEvents & FD_ACCEPT) {
  641.     TcpAccept(infoPtr);
  642.     return 1;
  643.     }
  644.  
  645.  
  646.     /*
  647.      * Mask off unwanted events and compute the read/write mask so 
  648.      * we can notify the channel.
  649.      */
  650.  
  651.     events = infoPtr->readyEvents & infoPtr->watchEvents;
  652.  
  653.     if (events & FD_CLOSE) {
  654.     /*
  655.      * If the socket was closed and the channel is still interested
  656.      * in read events, then we need to ensure that we keep polling
  657.      * for this event until someone does something with the channel.
  658.      * Note that we do this before calling Tcl_NotifyChannel so we don't
  659.      * have to watch out for the channel being deleted out from under
  660.      * us.  This may cause a redundant trip through the event loop, but
  661.      * it's simpler than trying to do unwind protection.
  662.      */
  663.  
  664.     Tcl_Time blockTime = { 0, 0 };
  665.     Tcl_SetMaxBlockTime(&blockTime);
  666.     mask |= TCL_READABLE;
  667.     } else if (events & FD_READ) {
  668.     /*
  669.      * We must check to see if data is really available, since someone
  670.      * could have consumed the data in the meantime.
  671.      */
  672.  
  673.     status = (*winSock.ioctlsocket)(infoPtr->socket, FIONREAD,
  674.         &nBytes);
  675.     if (status != SOCKET_ERROR && nBytes > 0) {
  676.         mask |= TCL_READABLE;
  677.     } else {
  678.         /*
  679.          * We are in a strange state, probably because someone
  680.          * besides Tcl is reading from this socket.  Try to
  681.          * recover by clearing the read event.
  682.          */
  683.         
  684.         infoPtr->readyEvents &= ~(FD_READ);
  685.  
  686.          /*
  687.           * Re-issue WSAAsyncSelect() since we are gobbling up an
  688.           * event,  without letting the reader do any I/O to re-enable
  689.          * the notification.
  690.           */
  691.  
  692.          (void) (*winSock.WSAAsyncSelect)(infoPtr->socket, winSock.hwnd,
  693.              SOCKET_MESSAGE, infoPtr->selectEvents);
  694.     }
  695.     }
  696.     if (events & FD_WRITE) {
  697.     mask |= TCL_WRITABLE;
  698.     }
  699.  
  700.     if (mask) {
  701.     Tcl_NotifyChannel(infoPtr->channel, mask);
  702.     }
  703.     return 1;
  704. }
  705.  
  706. /*
  707.  *----------------------------------------------------------------------
  708.  *
  709.  * TcpBlockProc --
  710.  *
  711.  *    Sets a socket into blocking or non-blocking mode.
  712.  *
  713.  * Results:
  714.  *    0 if successful, errno if there was an error.
  715.  *
  716.  * Side effects:
  717.  *    None.
  718.  *
  719.  *----------------------------------------------------------------------
  720.  */
  721.  
  722. static int
  723. TcpBlockProc(instanceData, mode)
  724.     ClientData    instanceData;    /* The socket to block/un-block. */
  725.     int mode;            /* TCL_MODE_BLOCKING or
  726.                                  * TCL_MODE_NONBLOCKING. */
  727. {
  728.     SocketInfo *infoPtr = (SocketInfo *) instanceData;
  729.  
  730.     if (mode == TCL_MODE_NONBLOCKING) {
  731.     infoPtr->flags |= SOCKET_ASYNC;
  732.     } else {
  733.     infoPtr->flags &= ~(SOCKET_ASYNC);
  734.     }
  735.     return 0;
  736. }
  737.  
  738. /*
  739.  *----------------------------------------------------------------------
  740.  *
  741.  * TcpCloseProc --
  742.  *
  743.  *    This procedure is called by the generic IO level to perform
  744.  *    channel type specific cleanup on a socket based channel
  745.  *    when the channel is closed.
  746.  *
  747.  * Results:
  748.  *    0 if successful, the value of errno if failed.
  749.  *
  750.  * Side effects:
  751.  *    Closes the socket.
  752.  *
  753.  *----------------------------------------------------------------------
  754.  */
  755.  
  756.     /* ARGSUSED */
  757. static int
  758. TcpCloseProc(instanceData, interp)
  759.     ClientData instanceData;    /* The socket to close. */
  760.     Tcl_Interp *interp;        /* Unused. */
  761. {
  762.     SocketInfo *infoPtr = (SocketInfo *) instanceData;
  763.     SocketInfo **nextPtrPtr;
  764.     int errorCode = 0;
  765.  
  766.     /*
  767.      * Check that WinSock is initialized; do not call it if not, to
  768.      * prevent system crashes. This can happen at exit time if the exit
  769.      * handler for WinSock ran before other exit handlers that want to
  770.      * use sockets.
  771.      */
  772.  
  773.     if (winSock.hInstance != NULL) {
  774.         
  775.     /*
  776.          * Clean up the OS socket handle.  The default Windows setting
  777.      * for a socket is SO_DONTLINGER, which does a graceful shutdown
  778.      * in the background.
  779.          */
  780.     
  781.         if ((*winSock.closesocket)(infoPtr->socket) == SOCKET_ERROR) {
  782.             TclWinConvertWSAError((*winSock.WSAGetLastError)());
  783.             errorCode = Tcl_GetErrno();
  784.         }
  785.     }
  786.  
  787.     /*
  788.      * Remove the socket from socketList.
  789.      */
  790.  
  791.     for (nextPtrPtr = &socketList; (*nextPtrPtr) != NULL;
  792.      nextPtrPtr = &((*nextPtrPtr)->nextPtr)) {
  793.     if ((*nextPtrPtr) == infoPtr) {
  794.         (*nextPtrPtr) = infoPtr->nextPtr;
  795.         break;
  796.     }
  797.     }
  798.     ckfree((char *) infoPtr);
  799.     return errorCode;
  800. }
  801.  
  802. /*
  803.  *----------------------------------------------------------------------
  804.  *
  805.  * NewSocketInfo --
  806.  *
  807.  *    This function allocates and initializes a new SocketInfo
  808.  *    structure.
  809.  *
  810.  * Results:
  811.  *    Returns a newly allocated SocketInfo.
  812.  *
  813.  * Side effects:
  814.  *    Adds the socket to the global socket list.
  815.  *
  816.  *----------------------------------------------------------------------
  817.  */
  818.  
  819. static SocketInfo *
  820. NewSocketInfo(socket)
  821.     SOCKET socket;
  822. {
  823.     SocketInfo *infoPtr;
  824.  
  825.     infoPtr = (SocketInfo *) ckalloc((unsigned) sizeof(SocketInfo));
  826.     infoPtr->socket = socket;
  827.     infoPtr->flags = 0;
  828.     infoPtr->watchEvents = 0;
  829.     infoPtr->readyEvents = 0;
  830.     infoPtr->selectEvents = 0;
  831.     infoPtr->acceptProc = NULL;
  832.     infoPtr->lastError = 0;
  833.     infoPtr->nextPtr = socketList;
  834.     socketList = infoPtr;
  835.     return infoPtr;
  836. }
  837.  
  838. /*
  839.  *----------------------------------------------------------------------
  840.  *
  841.  * CreateSocket --
  842.  *
  843.  *    This function opens a new socket and initializes the
  844.  *    SocketInfo structure.
  845.  *
  846.  * Results:
  847.  *    Returns a new SocketInfo, or NULL with an error in interp.
  848.  *
  849.  * Side effects:
  850.  *    Adds a new socket to the socketList.
  851.  *
  852.  *----------------------------------------------------------------------
  853.  */
  854.  
  855. static SocketInfo *
  856. CreateSocket(interp, port, host, server, myaddr, myport, async)
  857.     Tcl_Interp *interp;        /* For error reporting; can be NULL. */
  858.     int port;            /* Port number to open. */
  859.     char *host;            /* Name of host on which to open port. */
  860.     int server;            /* 1 if socket should be a server socket,
  861.                  * else 0 for a client socket. */
  862.     char *myaddr;        /* Optional client-side address */
  863.     int myport;            /* Optional client-side port */
  864.     int async;            /* If nonzero, connect client socket
  865.                                  * asynchronously. */
  866. {
  867.     u_long flag = 1;            /* Indicates nonblocking mode. */
  868.     int asyncConnect = 0;        /* Will be 1 if async connect is
  869.                                          * in progress. */
  870.     struct sockaddr_in sockaddr;    /* Socket address */
  871.     struct sockaddr_in mysockaddr;    /* Socket address for client */
  872.     SOCKET sock;
  873.     SocketInfo *infoPtr;        /* The returned value. */
  874.  
  875.     /*
  876.      * Check that WinSock is initialized; do not call it if not, to
  877.      * prevent system crashes. This can happen at exit time if the exit
  878.      * handler for WinSock ran before other exit handlers that want to
  879.      * use sockets.
  880.      */
  881.     
  882.     if (winSock.hInstance == NULL) {
  883.         return NULL;
  884.     }
  885.     
  886.     if (! CreateSocketAddress(&sockaddr, host, port)) {
  887.     goto error;
  888.     }
  889.     if ((myaddr != NULL || myport != 0) &&
  890.         ! CreateSocketAddress(&mysockaddr, myaddr, myport)) {
  891.     goto error;
  892.     }
  893.  
  894.     sock = (*winSock.socket)(AF_INET, SOCK_STREAM, 0);
  895.     if (sock == INVALID_SOCKET) {
  896.     goto error;
  897.     }
  898.  
  899.     /*
  900.      * Set kernel space buffering
  901.      */
  902.  
  903.     TclSockMinimumBuffers(sock, TCP_BUFFER_SIZE);
  904.  
  905.     if (server) {
  906.     /*
  907.      * Bind to the specified port.  Note that we must not call setsockopt
  908.      * with SO_REUSEADDR because Microsoft allows addresses to be reused
  909.      * even if they are still in use.
  910.          *
  911.          * Bind should not be affected by the socket having already been
  912.          * set into nonblocking mode. If there is trouble, this is one place
  913.          * to look for bugs.
  914.      */
  915.     
  916.     if ((*winSock.bind)(sock, (struct sockaddr *) &sockaddr,
  917.         sizeof(sockaddr)) == SOCKET_ERROR) {
  918.             goto error;
  919.         }
  920.  
  921.         /*
  922.          * Set the maximum number of pending connect requests to the
  923.          * max value allowed on each platform (Win32 and Win32s may be
  924.          * different, and there may be differences between TCP/IP stacks).
  925.          */
  926.         
  927.     if ((*winSock.listen)(sock, SOMAXCONN) == SOCKET_ERROR) {
  928.         goto error;
  929.     }
  930.  
  931.     /*
  932.      * Add this socket to the global list of sockets.
  933.      */
  934.  
  935.     infoPtr = NewSocketInfo(sock);
  936.  
  937.     /*
  938.      * Set up the select mask for connection request events.
  939.      */
  940.  
  941.     infoPtr->selectEvents = FD_ACCEPT;
  942.     infoPtr->watchEvents |= FD_ACCEPT;
  943.  
  944.     } else {
  945.  
  946.         /*
  947.          * Try to bind to a local port, if specified.
  948.          */
  949.         
  950.     if (myaddr != NULL || myport != 0) { 
  951.         if ((*winSock.bind)(sock, (struct sockaddr *) &mysockaddr,
  952.             sizeof(struct sockaddr)) == SOCKET_ERROR) {
  953.         goto error;
  954.         }
  955.     }            
  956.     
  957.     /*
  958.      * Set the socket into nonblocking mode if the connect should be
  959.      * done in the background.
  960.      */
  961.     
  962.     if (async) {
  963.         if ((*winSock.ioctlsocket)(sock, FIONBIO, &flag) == SOCKET_ERROR) {
  964.         goto error;
  965.         }
  966.     }
  967.  
  968.     /*
  969.      * Attempt to connect to the remote socket.
  970.      */
  971.  
  972.     if ((*winSock.connect)(sock, (struct sockaddr *) &sockaddr,
  973.         sizeof(sockaddr)) == SOCKET_ERROR) {
  974.             TclWinConvertWSAError((*winSock.WSAGetLastError)());
  975.         if (Tcl_GetErrno() != EWOULDBLOCK) {
  976.         goto error;
  977.         }
  978.  
  979.         /*
  980.          * The connection is progressing in the background.
  981.          */
  982.  
  983.         asyncConnect = 1;
  984.         }
  985.  
  986.     /*
  987.      * Add this socket to the global list of sockets.
  988.      */
  989.  
  990.     infoPtr = NewSocketInfo(sock);
  991.  
  992.     /*
  993.      * Set up the select mask for read/write events.  If the connect
  994.      * attempt has not completed, include connect events.
  995.      */
  996.  
  997.     infoPtr->selectEvents = FD_READ | FD_WRITE | FD_CLOSE;
  998.     if (asyncConnect) {
  999.         infoPtr->flags |= SOCKET_ASYNC_CONNECT;
  1000.         infoPtr->selectEvents |= FD_CONNECT;
  1001.     }
  1002.     }
  1003.  
  1004.     /*
  1005.      * Register for interest in events in the select mask.  Note that this
  1006.      * automatically places the socket into non-blocking mode.
  1007.      */
  1008.  
  1009.     (void) (*winSock.WSAAsyncSelect)(infoPtr->socket, winSock.hwnd,
  1010.         SOCKET_MESSAGE, infoPtr->selectEvents);
  1011.  
  1012.     return infoPtr;
  1013.  
  1014. error:
  1015.     TclWinConvertWSAError((*winSock.WSAGetLastError)());
  1016.     if (interp != NULL) {
  1017.     Tcl_AppendResult(interp, "couldn't open socket: ",
  1018.         Tcl_PosixError(interp), (char *) NULL);
  1019.     }
  1020.     if (sock != INVALID_SOCKET) {
  1021.     (*winSock.closesocket)(sock);
  1022.     }
  1023.     return NULL;
  1024. }
  1025.  
  1026. /*
  1027.  *----------------------------------------------------------------------
  1028.  *
  1029.  * CreateSocketAddress --
  1030.  *
  1031.  *    This function initializes a sockaddr structure for a host and port.
  1032.  *
  1033.  * Results:
  1034.  *    1 if the host was valid, 0 if the host could not be converted to
  1035.  *    an IP address.
  1036.  *
  1037.  * Side effects:
  1038.  *    Fills in the *sockaddrPtr structure.
  1039.  *
  1040.  *----------------------------------------------------------------------
  1041.  */
  1042.  
  1043. static int
  1044. CreateSocketAddress(sockaddrPtr, host, port)
  1045.     struct sockaddr_in *sockaddrPtr;    /* Socket address */
  1046.     char *host;                /* Host.  NULL implies INADDR_ANY */
  1047.     int port;                /* Port number */
  1048. {
  1049.     struct hostent *hostent;        /* Host database entry */
  1050.     struct in_addr addr;        /* For 64/32 bit madness */
  1051.  
  1052.     /*
  1053.      * Check that WinSock is initialized; do not call it if not, to
  1054.      * prevent system crashes. This can happen at exit time if the exit
  1055.      * handler for WinSock ran before other exit handlers that want to
  1056.      * use sockets.
  1057.      */
  1058.  
  1059.     if (winSock.hInstance == NULL) {
  1060.         Tcl_SetErrno(EFAULT);
  1061.         return 0;
  1062.     }
  1063.     
  1064.     (void) memset((char *) sockaddrPtr, '\0', sizeof(struct sockaddr_in));
  1065.     sockaddrPtr->sin_family = AF_INET;
  1066.     sockaddrPtr->sin_port = (*winSock.htons)((short) (port & 0xFFFF));
  1067.     if (host == NULL) {
  1068.     addr.s_addr = INADDR_ANY;
  1069.     } else {
  1070.         addr.s_addr = (*winSock.inet_addr)(host);
  1071.         if (addr.s_addr == INADDR_NONE) {
  1072.             hostent = (*winSock.gethostbyname)(host);
  1073.             if (hostent != NULL) {
  1074.                 memcpy((char *) &addr,
  1075.                         (char *) hostent->h_addr_list[0],
  1076.                         (size_t) hostent->h_length);
  1077.             } else {
  1078. #ifdef    EHOSTUNREACH
  1079.                 Tcl_SetErrno(EHOSTUNREACH);
  1080. #else
  1081. #ifdef ENXIO
  1082.                 Tcl_SetErrno(ENXIO);
  1083. #endif
  1084. #endif
  1085.         return 0;    /* Error. */
  1086.         }
  1087.     }
  1088.     }
  1089.  
  1090.     /*
  1091.      * NOTE: On 64 bit machines the assignment below is rumored to not
  1092.      * do the right thing. Please report errors related to this if you
  1093.      * observe incorrect behavior on 64 bit machines such as DEC Alphas.
  1094.      * Should we modify this code to do an explicit memcpy?
  1095.      */
  1096.  
  1097.     sockaddrPtr->sin_addr.s_addr = addr.s_addr;
  1098.     return 1;    /* Success. */
  1099. }
  1100.  
  1101. /*
  1102.  *----------------------------------------------------------------------
  1103.  *
  1104.  * WaitForSocketEvent --
  1105.  *
  1106.  *    Waits until one of the specified events occurs on a socket.
  1107.  *
  1108.  * Results:
  1109.  *    Returns 1 on success or 0 on failure, with an error code in
  1110.  *    errorCodePtr.
  1111.  *
  1112.  * Side effects:
  1113.  *    Processes socket events off the system queue.
  1114.  *
  1115.  *----------------------------------------------------------------------
  1116.  */
  1117.  
  1118. static int
  1119. WaitForSocketEvent(infoPtr, events, errorCodePtr)
  1120.     SocketInfo *infoPtr;    /* Information about this socket. */
  1121.     int events;            /* Events to look for. */
  1122.     int *errorCodePtr;        /* Where to store errors? */
  1123. {
  1124.     MSG msg;
  1125.     int result = 1;
  1126.     int oldMode;
  1127.  
  1128.     /*
  1129.      * Be sure to disable event servicing so we are truly modal.
  1130.      */
  1131.  
  1132.     oldMode = Tcl_SetServiceMode(TCL_SERVICE_NONE);
  1133.     
  1134.     while (!(infoPtr->readyEvents & events)) {
  1135.     if (infoPtr->flags & SOCKET_ASYNC) {
  1136.         if (!PeekMessage(&msg, winSock.hwnd, SOCKET_MESSAGE,
  1137.             SOCKET_MESSAGE, PM_REMOVE)) {
  1138.         *errorCodePtr = EWOULDBLOCK;
  1139.         result = 0;
  1140.         break;
  1141.         }
  1142.     } else {
  1143.         /*
  1144.          * Look for a socket event.  Note that we will be getting
  1145.          * events for all of Tcl's sockets, not just the one we wanted.
  1146.          */
  1147.  
  1148.         result = GetMessage(&msg, winSock.hwnd, SOCKET_MESSAGE,
  1149.             SOCKET_MESSAGE);
  1150.         if (result == -1) {
  1151.         TclWinConvertError(GetLastError());
  1152.         *errorCodePtr = Tcl_GetErrno();
  1153.         result = 0;
  1154.         break;
  1155.         }
  1156.  
  1157.         /*
  1158.          * I don't think we can get a WM_QUIT during a tight modal
  1159.          * loop, but just in case...
  1160.          */
  1161.  
  1162.         if (result == 0) {
  1163.         panic("WaitForSocketEvent: Got WM_QUIT during modal loop!");
  1164.         }
  1165.     }
  1166.  
  1167.     /*
  1168.      * Dispatch the message and then check for an error on the socket.
  1169.      */
  1170.  
  1171.     infoPtr->lastError = 0;
  1172.     DispatchMessage(&msg);
  1173.     if (infoPtr->lastError) {
  1174.         *errorCodePtr = infoPtr->lastError;
  1175.         result = 0;
  1176.         break;
  1177.     }
  1178.     }
  1179.  
  1180.     (void) Tcl_SetServiceMode(oldMode);
  1181.     return result;
  1182. }
  1183.  
  1184. /*
  1185.  *----------------------------------------------------------------------
  1186.  *
  1187.  * Tcl_OpenTcpClient --
  1188.  *
  1189.  *    Opens a TCP client socket and creates a channel around it.
  1190.  *
  1191.  * Results:
  1192.  *    The channel or NULL if failed.  An error message is returned
  1193.  *    in the interpreter on failure.
  1194.  *
  1195.  * Side effects:
  1196.  *    Opens a client socket and creates a new channel.
  1197.  *
  1198.  *----------------------------------------------------------------------
  1199.  */
  1200.  
  1201. Tcl_Channel
  1202. Tcl_OpenTcpClient(interp, port, host, myaddr, myport, async)
  1203.     Tcl_Interp *interp;            /* For error reporting; can be NULL. */
  1204.     int port;                /* Port number to open. */
  1205.     char *host;                /* Host on which to open port. */
  1206.     char *myaddr;            /* Client-side address */
  1207.     int myport;                /* Client-side port */
  1208.     int async;                /* If nonzero, should connect
  1209.                                          * client socket asynchronously. */
  1210. {
  1211.     SocketInfo *infoPtr;
  1212.     char channelName[20];
  1213.  
  1214.     if (TclHasSockets(interp) != TCL_OK) {
  1215.     return NULL;
  1216.     }
  1217.  
  1218.     /*
  1219.      * Create a new client socket and wrap it in a channel.
  1220.      */
  1221.  
  1222.     infoPtr = CreateSocket(interp, port, host, 0, myaddr, myport, async);
  1223.     if (infoPtr == NULL) {
  1224.     return NULL;
  1225.     }
  1226.  
  1227.     sprintf(channelName, "sock%d", infoPtr->socket);
  1228.  
  1229.     infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
  1230.         (ClientData) infoPtr, (TCL_READABLE | TCL_WRITABLE));
  1231.     if (Tcl_SetChannelOption(interp, infoPtr->channel, "-translation",
  1232.         "auto crlf") == TCL_ERROR) {
  1233.         Tcl_Close((Tcl_Interp *) NULL, infoPtr->channel);
  1234.         return (Tcl_Channel) NULL;
  1235.     }
  1236.     if (Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "")
  1237.         == TCL_ERROR) {
  1238.         Tcl_Close((Tcl_Interp *) NULL, infoPtr->channel);
  1239.         return (Tcl_Channel) NULL;
  1240.     }
  1241.     return infoPtr->channel;
  1242. }
  1243.  
  1244. /*
  1245.  *----------------------------------------------------------------------
  1246.  *
  1247.  * Tcl_MakeTcpClientChannel --
  1248.  *
  1249.  *    Creates a Tcl_Channel from an existing client TCP socket.
  1250.  *
  1251.  * Results:
  1252.  *    The Tcl_Channel wrapped around the preexisting TCP socket.
  1253.  *
  1254.  * Side effects:
  1255.  *    None.
  1256.  *
  1257.  * NOTE: Code contributed by Mark Diekhans (markd@grizzly.com)
  1258.  *
  1259.  *----------------------------------------------------------------------
  1260.  */
  1261.  
  1262. Tcl_Channel
  1263. Tcl_MakeTcpClientChannel(sock)
  1264.     ClientData sock;        /* The socket to wrap up into a channel. */
  1265. {
  1266.     SocketInfo *infoPtr;
  1267.     char channelName[20];
  1268.  
  1269.     if (TclHasSockets(NULL) != TCL_OK) {
  1270.     return NULL;
  1271.     }
  1272.  
  1273.     /*
  1274.      * Set kernel space buffering and non-blocking.
  1275.      */
  1276.  
  1277.     TclSockMinimumBuffers((SOCKET) sock, TCP_BUFFER_SIZE);
  1278.  
  1279.     infoPtr = NewSocketInfo((SOCKET) sock);
  1280.  
  1281.     /*
  1282.      * Start watching for read/write events on the socket.
  1283.      */
  1284.  
  1285.     infoPtr->selectEvents = FD_READ | FD_CLOSE | FD_WRITE;
  1286.     (void) (*winSock.WSAAsyncSelect)(infoPtr->socket, winSock.hwnd,
  1287.         SOCKET_MESSAGE, infoPtr->selectEvents);
  1288.  
  1289.     sprintf(channelName, "sock%d", infoPtr->socket);
  1290.     infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
  1291.         (ClientData) infoPtr, (TCL_READABLE | TCL_WRITABLE));
  1292.     Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto crlf");
  1293.     return infoPtr->channel;
  1294. }
  1295.  
  1296. /*
  1297.  *----------------------------------------------------------------------
  1298.  *
  1299.  * Tcl_OpenTcpServer --
  1300.  *
  1301.  *    Opens a TCP server socket and creates a channel around it.
  1302.  *
  1303.  * Results:
  1304.  *    The channel or NULL if failed.  An error message is returned
  1305.  *    in the interpreter on failure.
  1306.  *
  1307.  * Side effects:
  1308.  *    Opens a server socket and creates a new channel.
  1309.  *
  1310.  *----------------------------------------------------------------------
  1311.  */
  1312.  
  1313. Tcl_Channel
  1314. Tcl_OpenTcpServer(interp, port, host, acceptProc, acceptProcData)
  1315.     Tcl_Interp *interp;            /* For error reporting - may be
  1316.                                          * NULL. */
  1317.     int port;                /* Port number to open. */
  1318.     char *host;                /* Name of local host. */
  1319.     Tcl_TcpAcceptProc *acceptProc;    /* Callback for accepting connections
  1320.                                          * from new clients. */
  1321.     ClientData acceptProcData;        /* Data for the callback. */
  1322. {
  1323.     SocketInfo *infoPtr;
  1324.     char channelName[20];
  1325.  
  1326.     if (TclHasSockets(interp) != TCL_OK) {
  1327.     return NULL;
  1328.     }
  1329.  
  1330.     /*
  1331.      * Create a new client socket and wrap it in a channel.
  1332.      */
  1333.  
  1334.     infoPtr = CreateSocket(interp, port, host, 1, NULL, 0, 0);
  1335.     if (infoPtr == NULL) {
  1336.     return NULL;
  1337.     }
  1338.  
  1339.     infoPtr->acceptProc = acceptProc;
  1340.     infoPtr->acceptProcData = acceptProcData;
  1341.  
  1342.     sprintf(channelName, "sock%d", infoPtr->socket);
  1343.  
  1344.     infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
  1345.         (ClientData) infoPtr, 0);
  1346.     if (Tcl_SetChannelOption(interp, infoPtr->channel, "-eofchar", "")
  1347.         == TCL_ERROR) {
  1348.         Tcl_Close((Tcl_Interp *) NULL, infoPtr->channel);
  1349.         return (Tcl_Channel) NULL;
  1350.     }
  1351.  
  1352.     return infoPtr->channel;
  1353. }
  1354.  
  1355. /*
  1356.  *----------------------------------------------------------------------
  1357.  *
  1358.  * TcpAccept --
  1359.  *    Accept a TCP socket connection.  This is called by
  1360.  *    SocketEventProc and it in turns calls the registered accept
  1361.  *    procedure.
  1362.  *
  1363.  * Results:
  1364.  *    None.
  1365.  *
  1366.  * Side effects:
  1367.  *    Invokes the accept proc which may invoke arbitrary Tcl code.
  1368.  *
  1369.  *----------------------------------------------------------------------
  1370.  */
  1371.  
  1372. static void
  1373. TcpAccept(infoPtr)
  1374.     SocketInfo *infoPtr;    /* Socket to accept. */
  1375. {
  1376.     SOCKET newSocket;
  1377.     SocketInfo *newInfoPtr;
  1378.     struct sockaddr_in addr;
  1379.     int len;
  1380.     char channelName[20];
  1381.  
  1382.     /*
  1383.      * Accept the incoming connection request.
  1384.      */
  1385.  
  1386.     len = sizeof(struct sockaddr_in);
  1387.     newSocket = (*winSock.accept)(infoPtr->socket, (struct sockaddr *)&addr,
  1388.         &len);
  1389.  
  1390.     /*
  1391.      * Clear the ready mask so we can detect the next connection request.
  1392.      * Note that connection requests are level triggered, so if there is
  1393.      * a request already pending, a new event will be generated.
  1394.      */
  1395.  
  1396.     infoPtr->readyEvents &= ~(FD_ACCEPT);
  1397.  
  1398.     if (newSocket == INVALID_SOCKET) {
  1399.         return;
  1400.     }
  1401.  
  1402.     /*
  1403.      * Add this socket to the global list of sockets.
  1404.      */
  1405.  
  1406.     newInfoPtr = NewSocketInfo(newSocket);
  1407.  
  1408.     /*
  1409.      * Select on read/write events and create the channel.
  1410.      */
  1411.  
  1412.     newInfoPtr->selectEvents = (FD_READ | FD_WRITE | FD_CLOSE);
  1413.     (void) (*winSock.WSAAsyncSelect)(newInfoPtr->socket, winSock.hwnd, 
  1414.         SOCKET_MESSAGE, newInfoPtr->selectEvents);
  1415.  
  1416.     sprintf(channelName, "sock%d", newInfoPtr->socket);
  1417.     newInfoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
  1418.         (ClientData) newInfoPtr, (TCL_READABLE | TCL_WRITABLE));
  1419.     if (Tcl_SetChannelOption(NULL, newInfoPtr->channel, "-translation",
  1420.         "auto crlf") == TCL_ERROR) {
  1421.         Tcl_Close((Tcl_Interp *) NULL, newInfoPtr->channel);
  1422.         return;
  1423.     }
  1424.     if (Tcl_SetChannelOption(NULL, newInfoPtr->channel, "-eofchar", "")
  1425.         == TCL_ERROR) {
  1426.         Tcl_Close((Tcl_Interp *) NULL, newInfoPtr->channel);
  1427.         return;
  1428.     }
  1429.  
  1430.     /*
  1431.      * Invoke the accept callback procedure.
  1432.      */
  1433.  
  1434.     if (infoPtr->acceptProc != NULL) {
  1435.     (infoPtr->acceptProc) (infoPtr->acceptProcData, newInfoPtr->channel,
  1436.         (*winSock.inet_ntoa)(addr.sin_addr),
  1437.         (*winSock.ntohs)(addr.sin_port));
  1438.     }
  1439. }
  1440.  
  1441. /*
  1442.  *----------------------------------------------------------------------
  1443.  *
  1444.  * TcpInputProc --
  1445.  *
  1446.  *    This procedure is called by the generic IO level to read data from
  1447.  *    a socket based channel.
  1448.  *
  1449.  * Results:
  1450.  *    The number of bytes read or -1 on error.
  1451.  *
  1452.  * Side effects:
  1453.  *    Consumes input from the socket.
  1454.  *
  1455.  *----------------------------------------------------------------------
  1456.  */
  1457.  
  1458. static int
  1459. TcpInputProc(instanceData, buf, toRead, errorCodePtr)
  1460.     ClientData instanceData;        /* The socket state. */
  1461.     char *buf;                /* Where to store data. */
  1462.     int toRead;                /* Maximum number of bytes to read. */
  1463.     int *errorCodePtr;            /* Where to store error codes. */
  1464. {
  1465.     SocketInfo *infoPtr = (SocketInfo *) instanceData;
  1466.     int bytesRead;
  1467.     int error;
  1468.     
  1469.     *errorCodePtr = 0;
  1470.  
  1471.     /*
  1472.      * Check that WinSock is initialized; do not call it if not, to
  1473.      * prevent system crashes. This can happen at exit time if the exit
  1474.      * handler for WinSock ran before other exit handlers that want to
  1475.      * use sockets.
  1476.      */
  1477.  
  1478.     if (winSock.hInstance == NULL) {
  1479.         *errorCodePtr = EFAULT;
  1480.         return -1;
  1481.     }
  1482.  
  1483.     /*
  1484.      * First check to see if EOF was already detected, to prevent
  1485.      * calling the socket stack after the first time EOF is detected.
  1486.      */
  1487.  
  1488.     if (infoPtr->flags & SOCKET_EOF) {
  1489.     return 0;
  1490.     }
  1491.  
  1492.     /*
  1493.      * Check to see if the socket is connected before trying to read.
  1494.      */
  1495.  
  1496.     if ((infoPtr->flags & SOCKET_ASYNC_CONNECT)
  1497.         && ! WaitForSocketEvent(infoPtr,  FD_CONNECT, errorCodePtr)) {
  1498.     return -1;
  1499.     }
  1500.     
  1501.     /*
  1502.      * No EOF, and it is connected, so try to read more from the socket.
  1503.      * Note that we clear the FD_READ bit because read events are level
  1504.      * triggered so a new event will be generated if there is still data
  1505.      * available to be read.  We have to simulate blocking behavior here
  1506.      * since we are always using non-blocking sockets.
  1507.      */
  1508.  
  1509.     while (1) {
  1510.     if (infoPtr->readyEvents & (FD_CLOSE|FD_READ)) {
  1511.         bytesRead = (*winSock.recv)(infoPtr->socket, buf, toRead, 0);
  1512.         infoPtr->readyEvents &= ~(FD_READ);
  1513.  
  1514.         /*
  1515.          * Check for end-of-file condition or successful read.
  1516.          */
  1517.  
  1518.         if (bytesRead == 0) {
  1519.         infoPtr->flags |= SOCKET_EOF;
  1520.         }
  1521.         if (bytesRead != SOCKET_ERROR) {
  1522.         return bytesRead;
  1523.         }
  1524.  
  1525.         /*
  1526.          * If an error occurs after the FD_CLOSE has arrived,
  1527.          * then ignore the error and report an EOF.
  1528.          */
  1529.  
  1530.         if (infoPtr->readyEvents & FD_CLOSE) {
  1531.         infoPtr->flags |= SOCKET_EOF;
  1532.         return 0;
  1533.         }
  1534.  
  1535.         /*
  1536.          * Check for error condition or underflow in non-blocking case.
  1537.          */
  1538.  
  1539.         error = (*winSock.WSAGetLastError)();
  1540.         if ((infoPtr->flags & SOCKET_ASYNC) || (error != WSAEWOULDBLOCK)) {
  1541.         TclWinConvertWSAError(error);
  1542.         *errorCodePtr = Tcl_GetErrno();
  1543.         return -1;
  1544.         }
  1545.  
  1546.     } else if (infoPtr->flags & SOCKET_ASYNC) {
  1547.         *errorCodePtr = EWOULDBLOCK;
  1548.         return -1;
  1549.     }
  1550.  
  1551.     /*
  1552.      * In the blocking case, wait until the file becomes readable
  1553.      * or closed and try again.
  1554.      */
  1555.  
  1556.     if (!WaitForSocketEvent(infoPtr, FD_READ|FD_CLOSE, errorCodePtr)) {
  1557.         return -1;
  1558.     }
  1559.     }
  1560. }
  1561.  
  1562. /*
  1563.  *----------------------------------------------------------------------
  1564.  *
  1565.  * TcpOutputProc --
  1566.  *
  1567.  *    This procedure is called by the generic IO level to write data
  1568.  *    to a socket based channel.
  1569.  *
  1570.  * Results:
  1571.  *    The number of bytes written or -1 on failure.
  1572.  *
  1573.  * Side effects:
  1574.  *    Produces output on the socket.
  1575.  *
  1576.  *----------------------------------------------------------------------
  1577.  */
  1578.  
  1579. static int
  1580. TcpOutputProc(instanceData, buf, toWrite, errorCodePtr)
  1581.     ClientData instanceData;        /* The socket state. */
  1582.     char *buf;                /* Where to get data. */
  1583.     int toWrite;            /* Maximum number of bytes to write. */
  1584.     int *errorCodePtr;            /* Where to store error codes. */
  1585. {
  1586.     SocketInfo *infoPtr = (SocketInfo *) instanceData;
  1587.     int bytesWritten;
  1588.     int error;
  1589.  
  1590.     *errorCodePtr = 0;
  1591.  
  1592.     /*
  1593.      * Check that WinSock is initialized; do not call it if not, to
  1594.      * prevent system crashes. This can happen at exit time if the exit
  1595.      * handler for WinSock ran before other exit handlers that want to
  1596.      * use sockets.
  1597.      */
  1598.  
  1599.     if (winSock.hInstance == NULL) {
  1600.         *errorCodePtr = EFAULT;
  1601.         return -1;
  1602.     }
  1603.     
  1604.     /*
  1605.      * Check to see if the socket is connected before trying to write.
  1606.      */
  1607.     
  1608.     if ((infoPtr->flags & SOCKET_ASYNC_CONNECT)
  1609.         && ! WaitForSocketEvent(infoPtr,  FD_CONNECT, errorCodePtr)) {
  1610.     return -1;
  1611.     }
  1612.  
  1613.     while (1) {
  1614.     bytesWritten = (*winSock.send)(infoPtr->socket, buf, toWrite, 0);
  1615.     if (bytesWritten != SOCKET_ERROR) {
  1616.         /*
  1617.          * Since Windows won't generate a new write event until we hit
  1618.          * an overflow condition, we need to force the event loop to
  1619.          * poll until the condition changes.
  1620.          */
  1621.  
  1622.         if (infoPtr->watchEvents & FD_WRITE) {
  1623.         Tcl_Time blockTime = { 0, 0 };
  1624.         Tcl_SetMaxBlockTime(&blockTime);
  1625.         }        
  1626.         break;
  1627.     }
  1628.     
  1629.     /*
  1630.      * Check for error condition or overflow.  In the event of overflow, we
  1631.      * need to clear the FD_WRITE flag so we can detect the next writable
  1632.      * event.  Note that Windows only sends a new writable event after a
  1633.      * send fails with WSAEWOULDBLOCK.
  1634.      */
  1635.  
  1636.     error = (*winSock.WSAGetLastError)();
  1637.     if (error == WSAEWOULDBLOCK) {
  1638.         infoPtr->readyEvents &= ~(FD_WRITE);
  1639.         if (infoPtr->flags & SOCKET_ASYNC) {
  1640.         *errorCodePtr = EWOULDBLOCK;
  1641.         return -1;
  1642.         } 
  1643.     } else {
  1644.         TclWinConvertWSAError(error);
  1645.         *errorCodePtr = Tcl_GetErrno();
  1646.         return -1;
  1647.     }
  1648.  
  1649.     /*
  1650.      * In the blocking case, wait until the file becomes writable
  1651.      * or closed and try again.
  1652.      */
  1653.  
  1654.     if (!WaitForSocketEvent(infoPtr, FD_WRITE|FD_CLOSE, errorCodePtr)) {
  1655.         return -1;
  1656.     }
  1657.     }
  1658.  
  1659.     return bytesWritten;
  1660. }
  1661.  
  1662. /*
  1663.  *----------------------------------------------------------------------
  1664.  *
  1665.  * TcpGetOptionProc --
  1666.  *
  1667.  *    Computes an option value for a TCP socket based channel, or a
  1668.  *    list of all options and their values.
  1669.  *
  1670.  *    Note: This code is based on code contributed by John Haxby.
  1671.  *
  1672.  * Results:
  1673.  *    A standard Tcl result. The value of the specified option or a
  1674.  *    list of all options and    their values is returned in the
  1675.  *    supplied DString.
  1676.  *
  1677.  * Side effects:
  1678.  *    None.
  1679.  *
  1680.  *----------------------------------------------------------------------
  1681.  */
  1682.  
  1683. static int
  1684. TcpGetOptionProc(instanceData, interp, optionName, dsPtr)
  1685.     ClientData instanceData;        /* Socket state. */
  1686.     Tcl_Interp *interp;                 /* For error reporting - can be NULL */
  1687.     char *optionName;            /* Name of the option to
  1688.                                          * retrieve the value for, or
  1689.                                          * NULL to get all options and
  1690.                                          * their values. */
  1691.     Tcl_DString *dsPtr;            /* Where to store the computed
  1692.                                          * value; initialized by caller. */
  1693. {
  1694.     SocketInfo *infoPtr;
  1695.     struct sockaddr_in sockname;
  1696.     struct sockaddr_in peername;
  1697.     struct hostent *hostEntPtr;
  1698.     SOCKET sock;
  1699.     int size = sizeof(struct sockaddr_in);
  1700.     size_t len = 0;
  1701.     char buf[128];
  1702.  
  1703.     /*
  1704.      * Check that WinSock is initialized; do not call it if not, to
  1705.      * prevent system crashes. This can happen at exit time if the exit
  1706.      * handler for WinSock ran before other exit handlers that want to
  1707.      * use sockets.
  1708.      */
  1709.  
  1710.     if (winSock.hInstance == NULL) {
  1711.     if (interp) {
  1712.         Tcl_AppendResult(interp, "winsock is not initialized", NULL);
  1713.     }
  1714.         return TCL_ERROR;
  1715.     }
  1716.     
  1717.     infoPtr = (SocketInfo *) instanceData;
  1718.     sock = (int) infoPtr->socket;
  1719.     if (optionName != (char *) NULL) {
  1720.         len = strlen(optionName);
  1721.     }
  1722.  
  1723.     if ((len == 0) ||
  1724.             ((len > 1) && (optionName[1] == 'p') &&
  1725.                     (strncmp(optionName, "-peername", len) == 0))) {
  1726.         if ((*winSock.getpeername)(sock, (struct sockaddr *) &peername, &size)
  1727.                 == 0) {
  1728.             if (len == 0) {
  1729.                 Tcl_DStringAppendElement(dsPtr, "-peername");
  1730.                 Tcl_DStringStartSublist(dsPtr);
  1731.             }
  1732.             Tcl_DStringAppendElement(dsPtr,
  1733.                     (*winSock.inet_ntoa)(peername.sin_addr));
  1734.             hostEntPtr = (*winSock.gethostbyaddr)(
  1735.                 (char *) &(peername.sin_addr), sizeof(peername.sin_addr),
  1736.                 AF_INET);
  1737.             if (hostEntPtr != (struct hostent *) NULL) {
  1738.                 Tcl_DStringAppendElement(dsPtr, hostEntPtr->h_name);
  1739.             } else {
  1740.                 Tcl_DStringAppendElement(dsPtr,
  1741.                         (*winSock.inet_ntoa)(peername.sin_addr));
  1742.             }
  1743.             sprintf(buf, "%d", (*winSock.ntohs)(peername.sin_port));
  1744.             Tcl_DStringAppendElement(dsPtr, buf);
  1745.             if (len == 0) {
  1746.                 Tcl_DStringEndSublist(dsPtr);
  1747.             } else {
  1748.                 return TCL_OK;
  1749.             }
  1750.         } else {
  1751.             /*
  1752.              * getpeername failed - but if we were asked for all the options
  1753.              * (len==0), don't flag an error at that point because it could
  1754.              * be an fconfigure request on a server socket. (which have
  1755.              * no peer). {copied from unix/tclUnixChan.c}
  1756.              */
  1757.             if (len) {
  1758.         TclWinConvertWSAError((*winSock.WSAGetLastError)());
  1759.                 if (interp) {
  1760.                     Tcl_AppendResult(interp, "can't get peername: ",
  1761.                                      Tcl_PosixError(interp),
  1762.                                      (char *) NULL);
  1763.                 }
  1764.                 return TCL_ERROR;
  1765.             }
  1766.         }
  1767.     }
  1768.  
  1769.     if ((len == 0) ||
  1770.             ((len > 1) && (optionName[1] == 's') &&
  1771.                     (strncmp(optionName, "-sockname", len) == 0))) {
  1772.         if ((*winSock.getsockname)(sock, (struct sockaddr *) &sockname, &size)
  1773.                 == 0) {
  1774.             if (len == 0) {
  1775.                 Tcl_DStringAppendElement(dsPtr, "-sockname");
  1776.                 Tcl_DStringStartSublist(dsPtr);
  1777.             }
  1778.             Tcl_DStringAppendElement(dsPtr,
  1779.                     (*winSock.inet_ntoa)(sockname.sin_addr));
  1780.             hostEntPtr = (*winSock.gethostbyaddr)(
  1781.                 (char *) &(sockname.sin_addr), sizeof(peername.sin_addr),
  1782.                 AF_INET);
  1783.             if (hostEntPtr != (struct hostent *) NULL) {
  1784.                 Tcl_DStringAppendElement(dsPtr, hostEntPtr->h_name);
  1785.             } else {
  1786.                 Tcl_DStringAppendElement(dsPtr,
  1787.                         (*winSock.inet_ntoa)(sockname.sin_addr));
  1788.             }
  1789.             sprintf(buf, "%d", (*winSock.ntohs)(sockname.sin_port));
  1790.             Tcl_DStringAppendElement(dsPtr, buf);
  1791.             if (len == 0) {
  1792.                 Tcl_DStringEndSublist(dsPtr);
  1793.             } else {
  1794.                 return TCL_OK;
  1795.             }
  1796.         } else {
  1797.         if (interp) {
  1798.         TclWinConvertWSAError((*winSock.WSAGetLastError)());
  1799.         Tcl_AppendResult(interp, "can't get sockname: ",
  1800.                  Tcl_PosixError(interp),
  1801.                  (char *) NULL);
  1802.         }
  1803.         return TCL_ERROR;
  1804.     }
  1805.     }
  1806.  
  1807.     if (len > 0) {
  1808.         return Tcl_BadChannelOption(interp, optionName, "peername sockname");
  1809.     }
  1810.  
  1811.     return TCL_OK;
  1812. }
  1813.  
  1814. /*
  1815.  *----------------------------------------------------------------------
  1816.  *
  1817.  * TcpWatchProc --
  1818.  *
  1819.  *    Informs the channel driver of the events that the generic
  1820.  *    channel code wishes to receive on this socket.
  1821.  *
  1822.  * Results:
  1823.  *    None.
  1824.  *
  1825.  * Side effects:
  1826.  *    May cause the notifier to poll if any of the specified 
  1827.  *    conditions are already true.
  1828.  *
  1829.  *----------------------------------------------------------------------
  1830.  */
  1831.  
  1832. static void
  1833. TcpWatchProc(instanceData, mask)
  1834.     ClientData instanceData;        /* The socket state. */
  1835.     int mask;                /* Events of interest; an OR-ed
  1836.                                          * combination of TCL_READABLE,
  1837.                                          * TCL_WRITABLE and TCL_EXCEPTION. */
  1838. {
  1839.     SocketInfo *infoPtr = (SocketInfo *) instanceData;
  1840.     
  1841.     /*
  1842.      * Update the watch events mask.
  1843.      */
  1844.     
  1845.     infoPtr->watchEvents = 0;
  1846.     if (mask & TCL_READABLE) {
  1847.     infoPtr->watchEvents |= (FD_READ|FD_CLOSE|FD_ACCEPT);
  1848.     }
  1849.     if (mask & TCL_WRITABLE) {
  1850.     infoPtr->watchEvents |= (FD_WRITE);
  1851.     }
  1852.  
  1853.     /*
  1854.      * If there are any conditions already set, then tell the notifier to poll
  1855.      * rather than block.
  1856.      */
  1857.  
  1858.     if (infoPtr->readyEvents & infoPtr->watchEvents) {
  1859.     Tcl_Time blockTime = { 0, 0 };
  1860.     Tcl_SetMaxBlockTime(&blockTime);
  1861.     }        
  1862. }
  1863.  
  1864. /*
  1865.  *----------------------------------------------------------------------
  1866.  *
  1867.  * TcpGetProc --
  1868.  *
  1869.  *    Called from Tcl_GetChannelFile to retrieve an OS handle from inside
  1870.  *    a TCP socket based channel.
  1871.  *
  1872.  * Results:
  1873.  *    Returns TCL_OK with the socket in handlePtr.
  1874.  *
  1875.  * Side effects:
  1876.  *    None.
  1877.  *
  1878.  *----------------------------------------------------------------------
  1879.  */
  1880.  
  1881. static int
  1882. TcpGetHandleProc(instanceData, direction, handlePtr)
  1883.     ClientData instanceData;    /* The socket state. */
  1884.     int direction;        /* Not used. */
  1885.     ClientData *handlePtr;    /* Where to store the handle.  */
  1886. {
  1887.     SocketInfo *statePtr = (SocketInfo *) instanceData;
  1888.  
  1889.     *handlePtr = (ClientData) statePtr->socket;
  1890.     return TCL_OK;
  1891. }
  1892.  
  1893. /*
  1894.  *----------------------------------------------------------------------
  1895.  *
  1896.  * SocketProc --
  1897.  *
  1898.  *    This function is called when WSAAsyncSelect has been used
  1899.  *    to register interest in a socket event, and the event has
  1900.  *    occurred.
  1901.  *
  1902.  * Results:
  1903.  *    0 on success.
  1904.  *
  1905.  * Side effects:
  1906.  *    The flags for the given socket are updated to reflect the
  1907.  *    event that occured.
  1908.  *
  1909.  *----------------------------------------------------------------------
  1910.  */
  1911.  
  1912. static LRESULT CALLBACK
  1913. SocketProc(hwnd, message, wParam, lParam)
  1914.     HWND hwnd;
  1915.     UINT message;
  1916.     WPARAM wParam;
  1917.     LPARAM lParam;
  1918. {
  1919.     int event, error;
  1920.     SOCKET socket;
  1921.     SocketInfo *infoPtr;
  1922.  
  1923.     if (message != SOCKET_MESSAGE) {
  1924.     return DefWindowProc(hwnd, message, wParam, lParam);
  1925.     }
  1926.  
  1927.     event = WSAGETSELECTEVENT(lParam);
  1928.     error = WSAGETSELECTERROR(lParam);
  1929.     socket = (SOCKET) wParam;
  1930.  
  1931.     /*
  1932.      * Find the specified socket on the socket list and update its
  1933.      * eventState flag.
  1934.      */
  1935.  
  1936.     for (infoPtr = socketList; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
  1937.     if (infoPtr->socket == socket) {
  1938.         /*
  1939.          * Update the socket state.
  1940.          */
  1941.  
  1942.         if (event & FD_CLOSE) {
  1943.         infoPtr->readyEvents &= ~(FD_WRITE|FD_ACCEPT);
  1944.         }
  1945.         if (event & FD_CONNECT) {
  1946.         /*
  1947.          * The socket is now connected, so clear the async connect
  1948.          * flag.
  1949.          */
  1950.  
  1951.         infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
  1952.  
  1953.         /*
  1954.          * Remember any error that occurred so we can report
  1955.          * connection failures.
  1956.          */
  1957.  
  1958.         if (error != ERROR_SUCCESS) {
  1959.             TclWinConvertWSAError(error);
  1960.             infoPtr->lastError = Tcl_GetErrno();
  1961.         }
  1962.  
  1963.         } 
  1964.         infoPtr->readyEvents |= event;
  1965.         break;
  1966.     }
  1967.     }
  1968.  
  1969.     /*
  1970.      * Flush the Tcl event queue before returning to the event loop.
  1971.      */
  1972.  
  1973.     Tcl_ServiceAll();
  1974.  
  1975.     return 0;
  1976. }
  1977.  
  1978. /*
  1979.  *----------------------------------------------------------------------
  1980.  *
  1981.  * Tcl_GetHostName --
  1982.  *
  1983.  *    Returns the name of the local host.
  1984.  *
  1985.  * Results:
  1986.  *    Returns a string containing the host name, or NULL on error.
  1987.  *    The returned string must be freed by the caller.
  1988.  *
  1989.  * Side effects:
  1990.  *    None.
  1991.  *
  1992.  *----------------------------------------------------------------------
  1993.  */
  1994.  
  1995. char *
  1996. Tcl_GetHostName()
  1997. {
  1998.     if (TclHasSockets(NULL) != TCL_OK) {
  1999.     return "";
  2000.     }
  2001.  
  2002.     if (hostnameInitialized) {
  2003.         return hostname;
  2004.     }
  2005.     if ((*winSock.gethostname)(hostname, 100) == 0) {
  2006.         hostnameInitialized = 1;
  2007.         return hostname;
  2008.     }
  2009.     return (char *) NULL;
  2010. }
  2011.  
  2012. /*
  2013.  *----------------------------------------------------------------------
  2014.  *
  2015.  * TclWinGetSockOpt, et al. --
  2016.  *
  2017.  *    These functions are wrappers that let us bind the WinSock
  2018.  *    API dynamically so we can run on systems that don't have
  2019.  *    the wsock32.dll.  We need wrappers for these interfaces
  2020.  *    because they are called from the generic Tcl code.
  2021.  *
  2022.  * Results:
  2023.  *    As defined for each function.
  2024.  *
  2025.  * Side effects:
  2026.  *    As defined for each function.
  2027.  *
  2028.  *----------------------------------------------------------------------
  2029.  */
  2030.  
  2031. int PASCAL FAR
  2032. TclWinGetSockOpt(SOCKET s, int level, int optname, char FAR * optval,
  2033.     int FAR *optlen)
  2034. {
  2035.     /*
  2036.      * Check that WinSock is initialized; do not call it if not, to
  2037.      * prevent system crashes. This can happen at exit time if the exit
  2038.      * handler for WinSock ran before other exit handlers that want to
  2039.      * use sockets.
  2040.      */
  2041.  
  2042.     if (winSock.hInstance == NULL) {
  2043.         return SOCKET_ERROR;
  2044.     }
  2045.     
  2046.     return (*winSock.getsockopt)(s, level, optname, optval, optlen);
  2047. }
  2048.  
  2049. int PASCAL FAR
  2050. TclWinSetSockOpt(SOCKET s, int level, int optname, const char FAR * optval,
  2051.     int optlen)
  2052. {
  2053.     /*
  2054.      * Check that WinSock is initialized; do not call it if not, to
  2055.      * prevent system crashes. This can happen at exit time if the exit
  2056.      * handler for WinSock ran before other exit handlers that want to
  2057.      * use sockets.
  2058.      */
  2059.  
  2060.     if (winSock.hInstance == NULL) {
  2061.         return SOCKET_ERROR;
  2062.     }
  2063.  
  2064.     return (*winSock.setsockopt)(s, level, optname, optval, optlen);
  2065. }
  2066.  
  2067. u_short PASCAL FAR
  2068. TclWinNToHS(u_short netshort)
  2069. {
  2070.     /*
  2071.      * Check that WinSock is initialized; do not call it if not, to
  2072.      * prevent system crashes. This can happen at exit time if the exit
  2073.      * handler for WinSock ran before other exit handlers that want to
  2074.      * use sockets.
  2075.      */
  2076.  
  2077.     if (winSock.hInstance == NULL) {
  2078.         return (u_short) -1;
  2079.     }
  2080.  
  2081.     return (*winSock.ntohs)(netshort);
  2082. }
  2083.  
  2084. struct servent FAR * PASCAL FAR
  2085. TclWinGetServByName(const char FAR * name, const char FAR * proto)
  2086. {
  2087.     /*
  2088.      * Check that WinSock is initialized; do not call it if not, to
  2089.      * prevent system crashes. This can happen at exit time if the exit
  2090.      * handler for WinSock ran before other exit handlers that want to
  2091.      * use sockets.
  2092.      */
  2093.  
  2094.     if (winSock.hInstance == NULL) {
  2095.         return (struct servent FAR *) NULL;
  2096.     }
  2097.  
  2098.     return (*winSock.getservbyname)(name, proto);
  2099. }
  2100.